home *** CD-ROM | disk | FTP | other *** search
Text File | 1985-04-30 | 59.0 KB | 1,850 lines | [TEXT/ttxt] |
- {$X-} {Turn off stack expansion. This is a Lisa concept, not needed on Mac}
- {$U-} {Turn off the Lisa Libraries. This is required by the WorkShop}
- {$R-} {Turn off range checking}
-
- Program LaserPrinting;
-
- (*
- -- Jeffery J. Bradford, Macintosh Technical Support, Jan 1985
- --
- -- This is a printing example which demonstrates how to print using
- -- the Printing Manager. To use the calls of the Printing Manager
- -- link with obj/PrLink.obj.
- --
- -- This program was written to test out printing cases for the LaserWriter.
- -- If you want to use it to test your own stuff, add the procedure and
- -- call it from the menu list. (see how the program works - its simple).
- -- To print just put your procedure into the Case statement in the Print loop.
- --
- -- The printer dialogs are in a separate menu so you can set up the
- -- format any way you want and then choose Printing Operation from
- -- another menu. Also, be sure to select the desired font, style, and
- -- text size before selecting the print menu item.
- --
- -- If you follow the steps below, your code should print on the Imagewriter
- -- as well as the LaserWriter without any problem.
- --
- -- 0. Link with obj/prLink.obj.
- -- 0. include {$U Obj/MacPrint } MacPrint; in the USES statment.
- --
- -- 1. PrOpen to open the Printing Mgr resource file.
- -- 2. PrintDefault to set the initial default settings
- -- 2a PrValidate to set the initial default settings also
- --
- -- now you are ready to print:
- -- 3. PrOpenDoc to open the printing grafport.
- -- 4. PrOpenPage to setup a new page up for printing.
- -- 5. Draw into printer port whatever you want printed.
- -- 6. PrClosePage to finish the current page print
- -- 7. PrCloseDoc to close and dealocate the printing grafport.
- --
- -- now you are finished printing
- -- 8. PrClose to close the Printing Mgr resource file
- --
- --
- *)
-
- USES
- {$U Obj/Memtypes } MemTypes,
- {$U Obj/QuickDraw } QuickDraw,
- {$U Obj/OSIntf } OSIntf,
- {$U Obj/ToolIntf } ToolIntf,
- {$U Obj/PackIntf } PackIntf,
- {$U Obj/MacPrint } MacPrint;
-
- CONST
- Bit7 = 7;
- {menu stuff}
- AppleMenu = 256;
- PrintMenu = 257;
- FontMenu = 258;
- StyleMenu = 259;
- PrDlogMenu= 260;
- PrDrvrMenu= 261;
- PicScrMenu= 262;
-
- {print tests for Pr Mgr only}
- PrDrawPicture = 1;
- PrMakeQDCalls = 2;
- PrFramePage = 3;
- PrFrameText = 4;
- PrUseTextBox = 5;
- PrBitMap = 6;
- PrChkSetOrig = 7;
- PrChkPicComm = 8;
- PrRotateTex = 9;
- PrFineGrid = 10;
- PrSmothPloy = 11;
-
- {devices}
- theScreen = 0;
- theImageW = 1;
- theDaisyW = 2;
- theLaserW = 3;
-
- {picture comment constants}
- TextBegin = 150;
- TextEnd = 151;
- TextCenter= 154;
-
- PolyBegin = 160;
- PolyEnd = 161;
- PolyIgnore= 163;
- PolyVerb = 164;
-
- {window & dialog resource IDs}
- WindResID = 257;
-
-
-
- TYPE
- IconData = Array[0..95] of integer;
-
- GetStuff = Packed Record
- Case Integer of
- 0: (a0: Integer);
- 1: (b1,b0: SignedByte);
- 2: (f15,f14,f13,f12,f11,f10,f9,f8,f7,f6,f5,f4,f3,f2,f1,f0: Boolean)
- End;
-
- LMwordPtr = ^Integer; {pointer to low memory address}
-
-
- VAR
- {bit map stuff}
- icons: Array[0..5] of IconData; {store 6 icons in here}
- whichIcon: integer; {holds icon ID number}
- QDPicture: PicHandle; {handle to the QD Picture}
-
- {global program stuff}
- Finished: Boolean; {used to terminate the program}
- ClockCursor: CursHandle; {handle to the waiting watch cursor}
-
- {font stuff}
- CurntFontID: Integer; {holds the currently selected text font}
- CurntStyleID: Style; {holds the currently selected text style}
- CurntSizeID: Integer; {holds the currently selected text size}
- PrevFontChked: Integer; {holds the previously slected font}
-
- {printer stuff}
- PrRecordHdl: THPrint; {handle to the print record}
- PrPortStorage: TPrPort; {storage for the printer grafport}
- PrintPort: TPPrPort; {pointer to the printers grafport}
- DefaltPage: Rect; {holds the currently selected printer page size}
- CurPrTest: Integer; {holds the value to the current drawing routine}
- PrDlgPtr: DialogPtr; {pointer to the cancel/pause dialog}
- PrStopDlgRec:DialogRecord;{record for the cance/pause dialog}
-
- {window stuff}
- DragArea, {holds the area where window can be dragged in}
- GrowArea, {holds the area to which a window's size can change}
- Screen: Rect; {holds the screen dimensions}
- aWindow: WindowPtr; {pointer to text window}
-
- {-----------------------------------------------------------------------------
- end of global variable definition
- -----------------------------------------------------------------------------}
-
- {The following procedures contain printing code to: Print text, print graphics,}
- {print a bitmap, print the screen, and test out weird things developers do}
-
- {-----------------------------------------------------------------------------}
-
- { Printing Manager Procedures }
-
- PROCEDURE FramePage (Where: integer); FORWARD;
- PROCEDURE PrintBitMap (Where: integer); FORWARD;
- PROCEDURE MakeQDCalls (where:integer); FORWARD;
- PROCEDURE ShowAllQDCalls(Where:integer); FORWARD;
- PROCEDURE BuildQDPicture(where:integer); FORWARD;
- PROCEDURE ShowQDPic (Where:integer); FORWARD;
- PROCEDURE UseTextBox (Where: Integer); FORWARD;
- PROCEDURE FrameText (Where: Integer); FORWARD;
- PROCEDURE PrintLables (Where: Integer); FORWARD;
- PROCEDURE PrintText (Where: Integer); FORWARD;
- PROCEDURE PrintRotText (Where: Integer); FORWARD;
- PROCEDURE PrintFineGrid (Where: Integer); FORWARD;
- PROCEDURE PrintPolygon (Where: Integer); FORWARD;
-
-
- { Printer Driver Procedures }
- PROCEDURE PutPicScrap; FORWARD;
- PROCEDURE PrDrBitMap; FORWARD;
- PROCEDURE PrDrScr_wEvtCtl; FORWARD;
- PROCEDURE PrDrScrBitMap; FORWARD;
- PROCEDURE PrDrStreamText; FORWARD;
- PROCEDURE PrDrPostScript; FORWARD;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetPrDialog(Printer: Integer);
- Var IType: Integer;
- IHdl: Handle;
- IRect: Rect;
- Begin
- PrDlgPtr := GetNewDialog(257, @PrStopDlgRec, Pointer(-1));
-
- {disable the continue item to start with}
- GetDItem(PrDLgPtr, 3, Itype, IHdl, IRect); {get the item}
- HiliteControl(ControlHandle(IHdl), 255); {disable it}
-
- {if its the laser disable the pause item}
- If Printer = theLaserW then
- begin
- GetDItem(PrDLgPtr, 2, Itype, IHdl, IRect); {get the item}
- HiliteControl(ControlHandle(IHdl), 255); {disable it}
- end;
-
- DrawDialog(PrDlgPtr);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE ChkForCanceOrPause;
- Var ProcessIt: Boolean;
- itemHit: Integer;
- itemHdl: Handle;
- itemRect: Rect;
- Event: EventRecord;
- DlgPtr: DialogPtr;
-
- Begin
- ProcessIt := GetNextEvent(EveryEvent, Event);
- If IsDialogEvent(Event) then
- If DialogSelect(Event, DlgPtr, ItemHit) then
- Case itemHit of
- 1: PrSetError(iPrAbort);
- 2: begin end; {pause enable continue disable pause go into repeat loop}
- 3: begin end; {continue and enable pause}
- End;
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintIt(PrintWhat: Integer);
- Var
- numCopies: Integer; {holds the number of copies the user wants}
- Count: Integer; {used to count number of copies}
- TempPort: GrafPtr; {holds the current port while printport is used}
- Status: TPrStatus; {record for status while spool printing occors}
- dummy: boolean; {just a dummy boolean for function assignment}
- thePrinter: integer; {ID of the type of printer}
-
- Begin
-
- {get the current port & save it}
- GetPort(TempPort);
-
- {get the type of printer we are printing to}
- thePrinter:= GetStuff(PrRecordHdl^^.PrStl.wDev).b1;
-
- {If current test is picture then create it}
- If CurPrTest = PrDrawPicture then
- BuildQDPicture(thePrinter);
-
- {set our idleproc to handle aborts & pauses; Setup the Dialog also}
- PrRecordHdl^^.prJob.pIdleProc := @ChkForCancelOrPause;
- SetPrDialog(thePrinter);
-
- {open up the printer port, port is set automaticly}
- PrintPort := PrOpenDoc(PrRecordHdl, @PrPortStorage, Nil);
-
- {loop on the number of copies}
- numCopies := PrRecordHdl^^.prJob.iCopies;
- For count := 1 to numCopies do
- begin
- PrOpenPage(PrintPort, Nil); {Nil= do not scale the drawing}
-
- Case CurPrTest of
- PrDrawPicture: ShowQDPic (thePrinter); {1}
- PrMakeQDCalls: ShowAllQDCalls(thePrinter); {2}
- PrFramePage: FramePage (thePrinter); {3}
- PrFrameText: FrameText (thePrinter); {4}
- PrUseTextBox: UseTextBox (thePrinter); {5}
- PrBitMap: PrintBitMap (thePrinter); {6}
- PrChkSetOrig: PrintLables (thePrinter); {7}
- PrChkPicComm: PrintText (thePrinter); {8}
- PrRotateTex: PrintRotText (thePrinter); {9}
- PrFineGrid: PrintFineGrid (thePrinter); {10}
- PrSmothPloy: PrintPolygon (thePrinter); {11}
- End;
-
- PrClosePage(PrintPort);
- end;
-
- PrCloseDoc(PrintPort); {close PrGrafport}
- SetPort(TempPort); {Reset the port}
-
- {If spooling was selected, print the file now}
- If (PrRecordHdl^^.PrJob.bJDocLoop = bSpoolLoop) AND (PrError=0)
- then PrPicFile(PrRecordHdl,@PrPortStorage, NIL, NIL, Status);
-
- {get rid of Cancel dialog}
- CloseDialog(PrDlgPtr);
- End;
-
- {-----------------------------------------------------------------------------}
-
- {AAA}
- {The procedures below print directly to the Driver}
-
-
- PROCEDURE PrDrBitMap;
- {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
- {here only to test the Driver without Pr Manager interference}
- Var
- srcBits : BitMap;
- srcRect : Rect;
-
- Begin
- PRCLOSE; {Only calls below needed, if going to directly to PrDriver }
-
- srcBits.baseAddr:=@icons[0]; {set start address for icon data}
- srcBits.rowBytes:=6; {set 6 as # of bytes per row}
- SetRect(srcBits.bounds,0,0,48,32); {48 X 32 pixels = 6 X 4 bytes}
-
- PrDRvrOpen; {not needed if PrOpen has been called}
- PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
- PrCtlCall(iPrBitsCtl, Ord(@srcBits), Ord(@SrcBits.bounds), 1);
- PrDrvrClose;
-
- PROPEN; {open up the Printing Manager again}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrDrScr_wEvtCtl;
- {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
- {here only to test the Driver without Pr Manager interference}
- Begin
- PRCLOSE; {Only calls below needed, if going to directly to PrDriver }
-
- PrDRvrOpen; {not needed if PrOpen has been called}
- PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
- PrCtlCall(iPrEvtCtl, lPrEvtAll, 0, 0);
- PrDrvrClose;
-
- PROPEN; {open up the Printing Manager again}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrDrScrBitMap;
- {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
- {here only to test the Driver without Pr Manager interference}
-
- Begin
- PRCLOSE; {Only calls below needed, if going to directly to PrDriver }
-
- PrDRvrOpen;
- PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
- PrCtlCall(iPrBitsCtl, Ord(@ScreenBits), Ord(@ScreenBits.bounds), 1);
- PrDrvrClose;
-
- PROPEN; {open up the Printing Manager again}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrDrStreamText;
- {This procedure prints directly to the Pr Driver, PrClose & PrOpen are}
- {here only to test the Driver without Pr Manager interference}
-
- Var TxT: Str255;
- len: Integer;
- lParam1: LongInt;
-
- Begin
- PRCLOSE; {Only calls below needed, if going to directly to PrDriver }
-
- TextFont(CurntFontID); {test changing the font}
- TextFace(CurntStyleID); {test changing the style}
- TextSize(CurntSizeID); {test changing the size}
-
- Txt := 'This is text streaming to the LaserWriter';
- Len := Length(Txt);
- lParam1 := $0003FFFF;
-
- PrDrvrOpen;
- PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
-
- PrCtlCall(iPrIOCtl, LongInt(@Txt)+1, LongInt(Len), 0);
- PrCtlCall(iPrDevCtl, lParam1, 0,0);
-
- PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
- PrCtlCall(iPrDevCtl, lParam1, 0,0);
-
- PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
- PrCtlCall(iPrDevCtl, lParam1, 0,0);
-
- PrCtlCall(iPrIOCtl, Ord(@Txt), LongInt(Len), 0);
- PrCtlCall(iPrDevCtl, lParam1, 0,0);
-
- PrCtlCall(iPrDevCtl, lPrPageEnd, 0, 0);
- PrDrvrClose;
-
- PROPEN; {open up the Printing Manager again}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrDrPostScript;
- Begin
- End;
-
- {-----------------------------------------------------------------------------}
-
- {BBB}
- {the procedures below are used to draw into the Print Managers port}
-
-
- PROCEDURE InitDisplayArea(Where:integer; Var DisplayArea: Rect);
- Begin
- If where = theScreen
- then begin
- SetPort(aWindow); {to be sure}
- SetOrigin(0,0); {reset from previuos screwy stuff}
- DisplayArea := aWindow^.portRect;
- eraseRect(DisplayArea);
- end
- else DisplayArea := PrRecordHdl^^.prInfoPT.rPage;
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE FramePage(Where: integer);
- {This procedure will frame the windoiw or printable page.}
- Var
- DisplayArea: Rect;
- TempPort: GrafPtr; {holds the current port while printport is used}
- halflen: integer; {used for centering the text}
- Starth: integer; {horizontal position of centered text}
- Startv: integer; {vertical position of centered text}
- dummy: boolean; {just a dummy boolean for function assignment}
-
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {frame the display area}
- Pensize(3,3);
- FrameRect(DisplayArea);
- pensize(1,1);
-
- {place some centered text in frame, first set the text params}
- TextFont(CurntFontID); {set the printers port font}
- TextFace(CurntStyleID); {set the printers port style}
- TextSize(CurntSizeID); {set the printers port size}
-
- {find the center}
- starth := (DisplayArea.right - DisplayArea.left) div 2;
- Halflen := StringWidth('The printable area is enclosed by this frame') Div 2;
- starth := starth - halflen;
- startv := (DisplayArea.bottom - DisplayArea.top) div 2;
-
- {move to position & draw}
- MoveTo(starth, startv);
- DrawString('The printable area is enclosed by this frame');
-
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintBitMap(where: integer);
- {This prints a bit map in the rPage area.}
- Var
- DisplayArea: Rect;
- srcBits: BitMap;
- srcRect: Rect;
- dummy: boolean;
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {set the bit map up}
- srcBits.baseAddr:=@icons[0]; {set start address for Lisa icon}
- srcBits.rowBytes:=6; {set 6 as # of bytes per row}
- SetRect(srcBits.bounds,0,0,48,32); {48 X 32 pixels = 6 X 4 bytes}
- srcRect:=srcBits.bounds; {set the source bounding rect}
-
- {show it}
- If where = theScreen then
- CopyBits(srcBits,thePort^.portBits,srcRect,DisplayArea,srcCopy,Nil) {fill scr}
- else
- CopyBits(srcBits,thePort^.portBits,srcRect,DefaltPage,srcCopy,Nil); {full page}
-
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE UseTextBox(Where: Integer);
- Var
- DisplayArea: Rect;
- Count: Integer; {used as a counter}
- TextPage: Rect; {destRect for the text}
- TextPtr: Ptr; {pointer to the actual text}
- TextLength: integer; {length of the text}
- TextJustify: integer; {justification for the text}
- ViewRect: Rect; {rect for viewing text}
- DestRect: Rect; {rect for storing text}
- TextHandle: TEHandle; {handle to text record}
- TextString: StringHandle; {store string from resources}
-
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {first setup the text in the TE record and draw it to the screen}
- ViewRect := DisplayArea; {set the display rect}
- DestRect := DisplayArea;
- InSetRect(DestRect,0,4); {make the destRect smaller}
-
- TextHandle := TENew(DestRect,ViewRect); {get a new record}
- TextHandle^^.txFont := CurntFontID; {set font for display}
- TextHandle^^.txFace := CurntStyleID; {set style for displaying the text}
- TextHandle^^.txSize := CurntSizeID; {set size for displaying the text}
-
- TextString := GetString(256); {get the test string from resources}
-
- HLock(Handle(TextString)); {lock string down}
- HLock(Handle(TextHandle)); {lock text handle down}
- Hlock(Handle(TextHandle^^.hText)); {lock the char handle down}
-
- For count := 1 to 5 do {insert it 5 times}
- begin
- TESetSelect(0,0,TextHandle); {set the place to insert at begining}
- TEInsert(pointer(ord4(TextString^)+1), {point to the first character}
- length(TextString^^), {get the length of the string}
- TextHandle); {pass the string to TextHandle}
- end;
-
- TECalText(TextHandle); {just to be sure everything is OK}
-
- TextPtr := TextHandle^^.hText^; {get pointer to the text, its locked}
- TextLength := TextHandle^^.TELength; {get the length of the text}
- TextJustify:= 0; {set the text justification}
-
- {NOTE: TextBox call eraseRect, so its S L O W on the LaserWriter}
- TextBox(TextPtr, TextLength, DisplayArea, TextJustify); {draw the text}
-
- HUnlock(Handle(TextHandle^^.hText)); {unlock the char handle
- HUnLock(Handle(TextHandle)); {unlock the text handle}
- HUnLock(Handle(TextString)); {unlock the string handle}
-
- TEDispose(TextHandle);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE FrameText(Where: Integer);
- Var Txt: Str255;
- len: integer;
- i: integer;
- DisplayArea: Rect;
- Frame: Rect;
- Start: Point;
- fInfo: FontInfo;
- ClpRgn: RgnHandle;
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {use current settings}
- TextFont(CurntFontID); {set the font}
- TextFace(CurntStyleID); {set the style}
- TextSize(CurntSizeID); {set the size}
-
- {always start the text at this point}
- Start.v := 50;
- Start.h := 50;
-
- {get the string dimensions}
- GetFontInfo(fInfo); {using current font}
- Frame.right := StringWidth('Have I been - ypgj - framed correctly') + Start.h;
- Frame.left := Start.h;
- Frame.bottom:= Start.v + fInfo.descent;
- Frame.top := Start.v - fInfo.ascent;
-
- {now draw the stuff}
- InSetRect(Frame, -1, -1); {move it out one pixel}
- FrameRect(Frame);
-
- (* this is for testing the clipping of text
- ClpRgn := NewRgn; {get a place to store clip region}
- GetClip(ClpRgn); {get the current clip region}
- ClipRect(Frame); {clip to it}
- *)
-
- Moveto(Start.h, Start.v);
- DrawString('Have I been - ypgj - framed correctly');
-
- (* this resets the clip
- SetClip(ClpRgn); {set the clip back to rPage}
- DisposeRgn(ClpRgn); {kill the clip region}
- *)
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintLables(Where: Integer);
- {NOTE: this procedure tested SetOrigin - it does not }
- { work within the PrOpenPage and PrClosePage loop.}
- Var DisplayArea: Rect;
- Frame: Rect;
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- SetRect(Frame,0,0,80,50); {set up the frame}
-
- {first row, three lables across}
- SetOrigin(0,0); PaintRoundRect(Frame,4,4);
- SetOrigin(-90,0); PaintRoundRect(Frame,4,4);
- SetOrigin(-180,0); PaintRoundRect(Frame,4,4);
-
- {second row, three lables across}
- SetOrigin(0,-60); PaintRoundRect(Frame,4,4);
- SetOrigin(-90,-60); PaintRoundRect(Frame,4,4);
- SetOrigin(-180,-60); PaintRoundRect(Frame,4,4);
-
- {third row, three lables across}
- SetOrigin(0,-120); PaintRoundRect(Frame,4,4);
- SetOrigin(-90,-120); PaintRoundRect(Frame,4,4);
- SetOrigin(-180,-120); PaintRoundRect(Frame,4,4);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintText(Where: Integer);
-
- {until its defined in interface, define it here}
- Type TTxtPicRec = Packed Record
- tJus: Byte;
- tFlip:Byte;
- tRot: Integer;
- tLine:Byte;
- tCmmt:Byte;
- End;
-
- Var DisplayArea: Rect;
- LineHt: Integer;
- LinePos: Integer;
- fInfo: FontInfo;
- PicComRec: TTxtPicRec;
- PicComPtr: QDPtr;
- PicComHdl: QDHandle;
-
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {setup the pic text comment record pointers, etc}
- PicComPtr := @PicComRec;
- PicComHdl := @PicComPtr;
-
- {initialize the TTxtPicRec}
- PicComRec.tFlip := 0; {none}
- PicComRec.tRot := 0; {rotation}
-
- {set the current font stuff}
- TextFont(CurntFontID); {test changing the font}
- TextFace(CurntStyleID); {test changing the style}
- TextSize(CurntSizeID); {test changing the size}
-
- {get the line height}
- GetFontInfo(fInfo); {using current font}
- LineHt := fInfo.descent + fInfo.ascent + fInfo.leading;
- LinePos := LineHT;
-
- {this is before starting any pic comments}
- SetOrigin(0,0);
- LinePos := LineHT; {move to the first line}
-
- Moveto(5,LinePos);DrawString('This is before any Pic Comments');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
-
- {----------test the "none" justification}
- PicComRec.tJus := 0; {NONE justify}
- PicComment(TextBegin, 6, PicComHdl); {TEXT BEGIN Comment}
-
- LinePos := LinePos + 2*LineHT;
- Moveto(5,LinePos);DrawString('This is with NONE justification');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
- (* PicComment(151, 0, NIL); {TEXT END Comment} *)
-
-
- {----------test the "left" justification}
- PicComRec.tJus := 1; {LEFT justify}
- PicComment(TextBegin, 6, PicComHdl); {TEXT BEGIN Comment}
-
- LinePos := LinePos + 2*LineHT;
- Moveto(5,LinePos);DrawString('This is with LEFT justification');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
- (* PicComment(151, 0, NIL); {TEXT END Comment} *)
-
-
- {----------test the "center" justification}
- PicComRec.tJus := 2; {CENTER justify}
- PicComment(TextBegin, 6, PicComHdl);
-
- LinePos := LinePos + 2*LineHT;
- Moveto(5,LinePos);DrawString('This is with CENTER justification');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
- (* PicComment(151, 0, NIL); {TEXT END Comment} *)
-
-
- {----------test the "right" justification}
- PicComRec.tJus := 3; {RIGHT justify}
- PicComment(TextBegin, 6, PicComHdl); {TEXT BEGIN Comment}
-
- LinePos := LinePos + 2*LineHT;
- Moveto(5,LinePos);DrawString('This is with RIGHT justification');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
- (* PicComment(151, 0, NIL); {TEXT END Comment} *)
-
- {----------test the "full" justification}
- PicComRec.tJus := 4; {FULL justify}
- PicComment(TextBegin, 6, PicComHdl); {TEXT BEGIN Comment}
-
- LinePos := LinePos + 2*LineHT;
- Moveto(5,LinePos);DrawString('This is with FULL justification');
-
- LinePos := LinePos + LineHT;
- Moveto(5,LinePos);DrawString('Did the string shrink or expand or stay the same');
-
- PicComment(TextEnd, 0, NIL); {TEXT END Comment}
-
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintRotText(Where: Integer);
-
- {until its defined in interface, define it here}
- Type TTxtPicRec = Packed Record
- tJus: Byte;
- tFlip:Byte;
- tRot: Integer;
- tLine:Byte;
- tCmmt:Byte;
- End;
-
- TTxtCenter = Packed Record
- yInt: Integer;
- yFrac:Integer;
- xInt: Integer;
- xFrac:Integer;
- End;
-
- Var DisplayArea: Rect;
- LineHt: Integer;
- LinePos: Integer;
- fInfo: FontInfo;
-
- PicComRec: TTxtPicRec;
- PicComPtr: QDPtr;
- PicComHdl: QDHandle;
-
- TexRotRec: TTxtCenter;
- TexRotPtr: QDPtr;
- TexRotHdl: QDHandle;
-
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {set the current font stuff}
- TextFont(CurntFontID); {use the current font}
- TextFace(CurntStyleID); {use the current style}
- TextSize(CurntSizeID); {use the current size}
-
- {setup the pic text comment record pointers, etc}
- PicComPtr := @PicComRec;
- PicComHdl := @PicComPtr;
-
- TexRotPtr := @TexRotRec;
- TexRotHdl := @TexRotPtr;
-
- PicComRec.tJus := 1; {left justify}
- PicComRec.tFlip:= 0; {none}
- PicComRec.tRot := 45; {rotate 45 degrees CW}
-
- TexRotRec.yInt := 70; {move down 60 pixels}
- TexRotRec.yFrac:= 0; {make it 60.0}
- TexRotRec.xInt := 20; {move across 20 pixels}
- TexRotRec.xFrac:= 0; {make it 20.0}
-
- PicComment(TextBegin, 6, PicComHdl);
- PicComment(TextCenter, 8, TexRotHdl);
-
- MoveTo(10,30); DrawString('This text is rotated 45 degrees');
-
- PicComment(TextEnd, 0, NIL);
-
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintFineGrid (Where: Integer);
- Var DisplayArea: Rect;
- Vinc, Hinc: integer;
- pos: integer;
- Boxes: integer;
- count: integer;
- FineLine: rect;
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- {divide the page into box's}
- Boxes := 16;
- Hinc := DisplayArea.right Div Boxes;
- Vinc := DisplayArea.bottom Div Boxes;
-
- {do the vertical lines first}
- FineLine.top := DisplayArea.Top;
- FineLine.bottom := DisplayArea.Bottom;
-
- pos := DisplayArea.Left; {start at the left}
- For count := 1 to boxes do
- begin
- FineLine.left:= pos;
- If where = theScreen
- then FineLine.right := pos + 1
- else FineLine.right := pos;
- FillRect(FineLine, black);
- pos := pos + Hinc;
- end;
-
- {do the horizontal lines next}
- FineLine.left := DisplayArea.left;
- FineLine.right := DisplayArea.right;
-
- pos := DisplayArea.top;
- For count := 1 to boxes do
- begin
- FineLine.top:= pos; {start at the top}
- If where = theScreen
- then FineLine.bottom := pos + 1
- else FineLine.bottom := pos;
- FillRect(FineLine, black);
- pos := pos + Vinc;
- end;
-
- FrameRect(DisplayArea);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PrintPolygon (Where: Integer);
- Type TPolyVerb = Packed Record
- f7,f6,f5,f4,f3,fPolyClose, fPolyFill, fPolyFrame:Boolean;
- End;
-
- Var DisplayArea: Rect;
- PolyComRec: TPolyVerb;
- PolyComPtr: QDPtr;
- PolyComHdl: QDHandle;
- PolyHdl: PolyHandle;
-
-
- Begin
- InitDisplayArea(Where, DisplayArea);
-
- If where = theLaserW then
- begin
- sysbeep(3);
- PolyComRec.fPolyClose := true; {closed the polygon}
- PolyComRec.fPolyFrame := true; {frame the polygon}
- PolyComRec.fPolyFill := false; {don't fill the polygon}
- PolyComPtr:= @PolyComRec; {get the pointer set up}
- PolyComHdl:= @PolyComPtr; {get the handle set up}
-
- {draw the rectangle}
- MoveTo(20,20); {set the initial position}
- PicComment(PolyBegin, 0, Nil); {start the polygon, simple 80 X 80 square}
- PicComment(PolyVerb, 1,PolyComHdl); {send the frame & close command}
- LineTo(100,20);
- LineTo(100,100);
- LineTo(20,100);
- LineTo(20,20);
- PicComment(PolyEnd, 0, Nil); {end the polygon}
-
- {draw the triangle}
- MoveTo(150,200);
- PolyComRec.fPolyFill := true; {fill the polygon}
- PicComment(PolyBegin, 0, Nil); {start the polygon, simple 80 X 80 square}
- PicComment(PolyVerb, 1,PolyComHdl); {send the fill, frame & close command}
- LineTo(200,250);
- LineTo(100,250);
- LineTo(150,200);
- PicComment(PolyEnd, 0, Nil); {end the polygon}
- end
-
-
- else {use the regular stuff and show it on the screen}
- begin
- PolyHdl := OpenPoly;
- MoveTo(20,20);
- LineTo(100,20);
- LineTo(100,100);
- LineTo(20,100);
- LineTo(20,20);
- ClosePoly;
- FramePoly(PolyHdl);
- KillPoly(PolyHdl);
-
- PolyHdl := OpenPoly;
- MoveTo(150,200);
- LineTo(200,250);
- LineTo(100,250);
- LineTo(150,200);
- ClosePoly;
- FillPoly(PolyHdl, LtGray);
- FramePoly(polyHdl);
- KillPoly(PolyHdl);
- end;
- End;
-
- {-----------------------------------------------------------------------------}
-
-
- PROCEDURE BuildQDPicture(where:integer);
- Var
- OriginalRect: Rect;
- SaveClip: RgnHandle;
-
- Begin
- SetRect(OriginalRect,0,0,719,363); {this rect holds the initial Pic}
- SaveClip := NewRgn; {get a Rgn to store the clip}
- GetClip(SaveClip); {save the current clip region}
- ClipRect(OriginalRect); {set the clip to the drawing area}
-
- QDPicture := OpenPicture(OriginalRect); {start the picture}
- Pensize(3,3);
- FrameRect(OriginalRect); {frame it}
- PenSize(1,1);
- MakeQDCalls(where); {draw the QD calls}
- ClosePicture; {close it}
-
- SetClip(SaveClip); {reset the clip }
- DisposeRgn(SaveClip); {get rid of new clip}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE ShowQDPic(Where:integer);
- Var DisplayArea: Rect;
- Begin
- If where = theScreen
- then begin
- InitDisplayArea(Where, DisplayArea);
- BuildQDPicture(where); {knock out some things if goint to Laser}
- DrawPicture(QDPicture, DisplayArea);
- end
-
- else {build the picture some where else}
- DrawPicture(QDPicture, DefaltPage);
-
- KillPicture(QDPicture);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE ShowAllQDCalls(Where:integer);
- Var DisplayArea: Rect;
- Begin
- InitDisplayArea(Where, DisplayArea);
- MakeQDCalls(Where);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DrawIcon(whichIcon,h,v: integer);
- {This procedure draws an icon at location h, v}
- Var
- srcBits : BitMap;
- srcRect, dstRect : Rect;
-
- Begin
- srcBits.baseAddr:=@icons[whichIcon]; {set start address for icon data}
- srcBits.rowBytes:=6; {set 6 as # of bytes per row}
- SetRect(srcBits.bounds,0,0,48,32); {48 X 32 pixels = 6 X 4 bytes}
- srcRect:=srcBits.bounds; {set the source bounding rect}
- dstRect:=srcRect; {make the destination rect the same}
- OffsetRect(dstRect,h,v); {offset from other icons}
-
- CopyBits(srcBits,thePort^.portBits,srcRect,dstRect,srcOr,Nil);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE MakeQDCalls(where:integer);
- VAR i: INTEGER;
- tempRect,
- OriginalRect : Rect;
- myPoly : PolyHandle;
- myRgn : RgnHandle;
- myPattern : Pattern;
-
- BEGIN
-
- {SetRect(OriginalRect,0,0,719,363); this rect holds the initial Pic}
-
- { draw two horizontal lines across the top }
- MoveTo(0,18);
- LineTo(719,18);
- MoveTo(0,20);
- LineTo(719,20);
-
- { draw divider lines }
- MoveTo(0,134);
- LineTo(719,134);
- MoveTo(0,248);
- LineTo(719,248);
- MoveTo(240,21);
- LineTo(240,363);
- MoveTo(480,21);
- LineTo(480,363);
-
- {set the current font stuff}
- TextFont(CurntFontID); {use the current font}
- TextFace(CurntStyleID); {use the current style}
- TextSize(CurntSizeID); {use the current size}
-
- {draw title}
- MoveTo(210,14);
- DrawString('Look what you can draw with QuickDraw');
-
-
- {--------- draw text samples --------- }
-
- MoveTo(80,34); DrawString('Text');
-
- TextFace([bold]);
- MoveTo(70,55); DrawString('Bold');
-
- TextFace([italic]);
- MoveTo(70,70); DrawString('Italic');
-
- TextFace([underline]);
- MoveTo(70,85); DrawString('Underline');
-
- TextFace([outline]);
- MoveTo(70,100); DrawString('Outline');
-
- TextFace([shadow]);
- MoveTo(70,115); DrawString('Shadow');
-
- TextFace([]); { restore to normal }
-
-
- { --------- draw line samples --------- }
-
- MoveTo(330,34); DrawString('Lines');
-
- MoveTo(280,25); Line(160,40);
-
- PenSize(3,2);
- MoveTo(280,35); Line(160,40);
-
- PenSize(6,4);
- MoveTo(280,46); Line(160,40);
-
- PenSize(12,8);
- PenPat(gray);
- MoveTo(280,61); Line(160,40);
-
- PenSize(15,10);
- StuffHex(@myPattern,'8040200002040800'); {create a new pattern}
- PenPat(myPattern); {set as the new pen pattern}
- MoveTo(280,80); Line(160,40);
- PenNormal;
-
- { --------- draw rectangle samples --------- }
-
- MoveTo(560,34); DrawString('Rectangles');
-
- SetRect(tempRect,510,40,570,70);
- FrameRect(tempRect);
-
- OffsetRect(tempRect,25,15);
- PenSize(3,2);
- EraseRect(tempRect); {this is so the top rect will not show thru the next one}
- FrameRect(tempRect);
-
- OffsetRect(tempRect,25,15);
- PaintRect(tempRect); {this rect is painted so we do not have to erase area}
-
- OffsetRect(tempRect,25,15);
- PenNormal;
- FillRect(tempRect,gray);
- FrameRect(tempRect);
-
- OffsetRect(tempRect,25,15);
- FillRect(tempRect,myPattern);
- FrameRect(tempRect);
-
- { --------- draw roundRect samples --------- }
-
- MoveTo(70,148); DrawString('RoundRects');
-
- SetRect(tempRect,30,150,90,180);
- FrameRoundRect(tempRect,30,20);
-
- OffsetRect(tempRect,25,15);
- PenSize(3,2);
- EraseRoundRect(tempRect,30,20);
- FrameRoundRect(tempRect,30,20);
-
- OffsetRect(tempRect,25,15);
- PaintRoundRect(tempRect,30,20);
-
- OffsetRect(tempRect,25,15);
- PenNormal;
- FillRoundRect(tempRect,30,20,gray);
- FrameRoundRect(tempRect,30,20);
-
- OffsetRect(tempRect,25,15);
- FillRoundRect(tempRect,30,20,myPattern);
- FrameRoundRect(tempRect,30,20);
-
- { --------- draw bitmap samples --------- }
-
- MoveTo(320,148); DrawString('BitMaps');
-
- DrawIcon(0,266,156);
- DrawIcon(1,336,156);
- DrawIcon(2,406,156);
- DrawIcon(3,266,196);
- DrawIcon(4,336,196);
- DrawIcon(5,406,196);
-
- { --------- draw ARC samples --------- }
-
- MoveTo(570,148); DrawString('Arcs');
-
- SetRect(tempRect,520,153,655,243);
- FillArc(tempRect,135,65,dkGray);
- FillArc(tempRect,200,130,myPattern);
- FillArc(tempRect,330,75,gray);
- FrameArc(tempRect,135,270);
- OffsetRect(tempRect,20,0);
- PaintArc(tempRect,45,90);
-
- { --------- draw polygon samples --------- }
-
- MoveTo(80,262); DrawString('Polygons');
-
- myPoly:=OpenPoly; {capture QD calls that make up the polygon}
- MoveTo(30,290);
- LineTo(30,280);
- LineTo(50,265);
- LineTo(90,265);
- LineTo(80,280);
- LineTo(95,290);
- LineTo(30,290);
- ClosePoly; { end of definition of the polygon}
-
- FramePoly(myPoly); {now use it just like you would a rectangle or etc.}
-
- OffsetPoly(myPoly,25,15);
- PenSize(3,2);
- ErasePoly(myPoly);
- FramePoly(myPoly);
-
- OffsetPoly(myPoly,25,15);
- PaintPoly(myPoly);
-
- OffsetPoly(myPoly,25,15);
- PenNormal;
- FillPoly(myPoly,gray);
- FramePoly(myPoly);
-
- OffsetPoly(myPoly,25,15);
- FillPoly(myPoly,myPattern);
- FramePoly(myPoly);
-
- KillPoly(myPoly);
-
- { --------- demonstrate regions --------- }
-
- MoveTo(320,262); DrawString('Regions');
-
- If where <> theLaserW
- then
- begin
-
- myRgn:=NewRgn; {allocate space of a new region}
- OpenRgn; {start saving region defintion calls}
-
- ShowPen; {OpenRgn calls HidePen so if drawing to screen call ShowPen }
- {if creating a picture delete this call}
-
- SetRect(tempRect,260,270,460,350);
- FrameRoundRect(tempRect,24,16); {rounded corner rectangle}
-
- MoveTo(275,335); { define triangular hole }
- LineTo(325,285);
- LineTo(375,335);
- LineTo(275,335);
-
- SetRect(tempRect,365,277,445,325); { oval hole }
- FrameOval(tempRect);
-
- HidePen; {this call would balance the ShowPen call set above}
- CloseRgn(myRgn); { end of definition of the region}
- PaintRgn(myRgn); {show the region with black pattern}
- DisposeRgn(myRgn); {dont need it any more so throw it away}
- end
-
- else
- begin
- MoveTo(270,300); DrawString('Dont use regions');
- Moveto(275,320); DrawString('on LaserPrinter');
- end;
-
- { --------- draw oval samples --------- }
-
- MoveTo(580,262); DrawString('Ovals');
-
- SetRect(tempRect,510,264,570,294);
- FrameOval(tempRect);
-
- OffsetRect(tempRect,25,15);
- PenSize(3,2);
- EraseOval(tempRect);
- FrameOval(tempRect);
-
- OffsetRect(tempRect,25,15);
- PaintOval(tempRect);
-
- OffsetRect(tempRect,25,15);
- PenNormal;
- FillOval(tempRect,gray);
- FrameOval(tempRect);
-
- OffsetRect(tempRect,25,15);
- FillOval(tempRect,myPattern);
- FrameOval(tempRect);
-
- END; {QDCalls}
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE ChkOnOffItem(MenuHdl:MenuHandle; item, fst, lst:Integer);
- Var i: integer;
- Begin
- For i := fst to lst do
- If item = i
- then CheckItem(MenuHdl, i, TRUE) {check it on in menu}
- else CheckItem(MenuHdl, i, FALSE); {check it off in menu}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE ProcessMenu_in(CodeWord:longint; fromMenu:Boolean);
- Var
- Menu_No, {menu number that was selected}
- Item_No: integer; {item in menu that was selected}
- NameHolder: Str255; {name holder for desk accessory or font}
- MenuHdl: MenuHandle; {handle to the menu}
- dummy: boolean;
- LDummy: LongInt;
- PrChooser: LMwordPtr; {used to disable/enable the chooser}
-
- Begin
- If CodeWord <> 0 then {go ahead and process the command}
- begin
- Menu_No := HiWord(CodeWord);
- Item_No := LoWord(CodeWord);
-
- Case Menu_No of
-
- AppleMenu: begin
- GetItem(GetMenu(AppleMenu), Item_No, NameHolder);
- If OpenDeskAcc(NameHolder) = 0
- then begin {put up a dialog saying it cannot open it} end;
- end;
-
- PrDlogMenu: begin
- Case Item_No of
- 1: begin
- dummy := PrStlDialog(PrRecordHdl);
- end;
- 2: begin
- If PrJobDialog(PrRecordHdl)
- then PrintIt(CurPrTest);
- end;
-
- {3: line divider}
-
- 4: begin
- PrChooser := LMwordPtr($946); {set the address}
- GetStuff(PrChooser^).f15 := FALSE; {set bit7 of $946}
- end;
- 5: begin
- PrChooser := LMwordPtr($946); {set the address}
- GetStuff(PrChooser^).f15 := TRUE; {set bit7 of $946}
- end;
-
- {6: line divider}
-
- 7:Finished := true; {terminate the program}
- End;
- end;
-
- PrintMenu: Begin
- MenuHdl := GetMenu(PrintMenu); {menu handle for PrTests}
- Case Item_No of
- 1: begin
- CurPrTest := PrFramePage;
- ChkOnOffItem(MenuHdl, 1, 1, 11);
- FramePage(theScreen);
- end;
-
- 2: begin
- CurPrTest := PrFrameText;
- ChkOnOffItem(MenuHdl, 2, 1, 11);
- FrameText(theScreen);
- end;
-
- 3: begin
- CurPrTest := PrMakeQDCalls;
- ChkOnOffItem(MenuHdl, 3, 1, 11);
- ShowAllQDCalls(theScreen);
- end;
-
- 4: begin
- CurPrTest := PrDrawPicture;
- ChkOnOffItem(MenuHdl, 4, 1, 11);
- ShowQDPic(theScreen);
- end;
-
- 5: begin
- CurPrTest := PrUseTextBox;
- ChkOnOffItem(MenuHdl, 5, 1, 11);
- UseTextBox(theScreen);
- end;
-
- 6: begin
- CurPrTest := PrBitMap;
- ChkOnOffItem(MenuHdl, 6, 1, 11);
- PrintBitMap(theScreen);
- end;
-
- 7: begin
- CurPrTest := PrChkSetOrig;
- ChkOnOffItem(MenuHdl, 7, 1, 11);
- PrintLables(theScreen);
- end;
-
- 8: begin
- CurPrTest := PrChkPicComm;
- ChkOnOffItem(MenuHdl, 8, 1, 11);
- PrintText(theScreen);
- end;
-
- 9: begin
- CurPrTest := PrRotateTex;
- ChkOnOffItem(MenuHdl, 9, 1, 11);
- PrintRotText(theScreen);
- end;
-
-
- 10: begin
- CurPrTest := PrFineGrid;
- ChkOnOffItem(MenuHdl, 10, 1, 11);
- PrintFineGrid(theScreen);
- end;
-
- 11: begin
- CurPrTest := PrSmothPloy;
- ChkOnOffItem(MenuHdl, 11, 1, 11);
- PrintPolygon(theScreen);
- end;
-
- End;
- End;
-
- FontMenu: begin
- MenuHdl := GetMenu(FontMenu); {menu handle for fonts}
- CheckItem(MenuHdl, PrevFontChked, False); {uncheck the prev.one}
- GetItem(MenuHdl, Item_No, NameHolder); {get new font name}
- PrevFontChked := Item_No; {save the new font No}
- GetFNum(NameHolder, CurntFontID); {get the font ID}
- CheckItem(MenuHdl, Item_No, True); {check it off in menu}
- end;
-
- StyleMenu: begin
- MenuHdl := GetMenu(StyleMenu); {menu handle for style}
- Case Item_No of
- 1:begin
- CurntStyleID := []; {plain}
- ChkOnOffItem(MenuHdl, 1, 1, 6);
- end;
- 2:begin
- CurntStyleID := CurntStyleID + [Bold];
- CheckItem(MenuHdl, 2, True); {check it off in menu}
- CheckItem(MenuHdl, 1, False); {uncheck it in menu}
- end;
- 3:begin
- CurntStyleID := CurntStyleID + [Italic];
- CheckItem(MenuHdl, 3, True); {check it off in menu}
- CheckItem(MenuHdl, 1, False); {uncheck it in menu}
- end;
- 4:begin
- CurntStyleID := CurntStyleID + [underline];
- CheckItem(MenuHdl, 4, True); {check it off in menu}
- CheckItem(MenuHdl, 1, False); {uncheck it in menu}
- end;
- 5:begin
- CurntStyleID := CurntStyleID + [outline];
- CheckItem(MenuHdl, 5, True); {check it off in menu}
- CheckItem(MenuHdl, 1, False); {uncheck it in menu}
- end;
- 6:begin
- CurntStyleID := CurntStyleID + [shadow];
- CheckItem(MenuHdl, 6, True); {check it off in menu}
- CheckItem(MenuHdl, 1, False); {uncheck it in menu}
- end;
-
- {7: line divider}
-
- 8:begin {9 point}
- CurntSizeID := 9;
- ChkOnOffItem(MenuHdl, 8, 8, 13);
- end;
- 9:begin {10 point}
- CurntSizeID := 10;
- ChkOnOffItem(MenuHdl, 9, 8, 13);
- end;
- 10:begin {12 point}
- CurntSizeID := 12;
- ChkOnOffItem(MenuHdl, 10, 8, 13);
- end;
- 11:begin {14 point}
- CurntSizeID := 14;
- ChkOnOffItem(MenuHdl, 11, 8, 13);
- end;
- 12:begin {18 point}
- CurntSizeID := 18;
- ChkOnOffItem(MenuHdl, 12, 8, 13);
- end;
- 13:begin {24 point}
- CurntSizeID := 24;
- ChkOnOffItem(MenuHdl, 13, 8, 13);
- end;
-
- End;
- end;
-
- PrDrvrMenu:begin
- Case Item_No of
- 1: PrDrBitMap;
- 2: PrDrScr_wEvtCtl;
- 3: PrDrScrBitMap;
- 4: PrDrStreamText;
- 5: PrDrPostScript;
- End;
- end;
-
- PicScrMenu:begin
- If Item_No = 1 then PutPicScrap;
- end;
-
- End;{case of Menu_No}
-
- HiliteMenu(0); {unhilite after processing menu}
- end; {the If codeword <> 0}
- End; {of ProcessMenu_in procedure}
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DealwthMouseDowns(Event:EventRecord);
- Var Location: integer;
- WindowPointedTo: WindowPtr;
- MouseLoc:Point;
- WindoLoc:integer;
- Begin
- MouseLoc := Event.Where;
- WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
- Case WindoLoc of
-
- inMenuBar: ProcessMenu_in(MenuSelect(MouseLoc), True);
-
- inSysWindow: SystemClick(Event,WindowPointedTo);
-
- inContent: begin end;
- (*If WindowPointedTo <> FrontWindow
- then SelectWindow(WindowPointedTo)
- else begin {do something} end;*)
-
- inGrow : begin end;
- (*If WindowPointedTo <> FrontWindow
- then SelectWindow(WindowPointedTo)
- else ReSizeWindow(WindowPointedTo,MouseLoc,GrowArea);*)
-
- inDrag :DragWindow(WindowPointedTo,MouseLoc,DragArea);
-
- inGoAway :If TrackGoAway(WindowPointedTo,MouseLoc)
- then
- begin
- CloseWindow(WindowPointedTo);
- Finished := true;
- end;
-
- End{ of case};
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DealwthKeyDowns(Event:EventRecord);
- Var Character:char;
- Begin
- Character:= CHR(Event.message MOD 256);
-
- If BitTst(@Event.modifier,Bit7)
- then
- begin {key board command}
- ProcessMenu_in(MenuKey(Character), False);
- end
- else
- begin {regular keyboard entry}
- {TEKey(Character,TextHandle);}
- {Scrolltext}
- end;
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DealwthActivates(Event: EventRecord);
- Var EventMsgWindow:WindowPtr;
- Begin
- EventMsgWindow := WindowPtr(Event.message);
- {DrawGrowIcon(EventMsgWindow);}
-
- If Odd(Event.modifiers) {then the window is becoming active}
- then
- begin
- SetPort(EventMsgWindow);
- {and activate whatever else you need}
- end
- else
- begin
- {deactivate whatever you need}
- end;
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DealwthUpdates(Event:EventRecord);
- Var EventMsgWindow,
- TempPort: WindowPtr;
- Begin
- EventMsgWindow := WindowPtr(Event.message);
- GetPort(TempPort); {Save the current port}
-
- SetPort (EventMsgWindow); {set the port to one in Evt.msg}
- BeginUpDate(EventMsgWindow);
- EraseRect(EventMsgWindow^.portRect);
- { WhichPrinter; Proc to ID the printer}
- {DrawGrowIcon(EventMsgWindow);}
- EndUpDate (EventMsgWindow);
- SetPort (TempPort); {restore to the previous port}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE MainEventLoop;
- Var Event:EventRecord;
- ProcessIt: Boolean;
- Begin
- Repeat
- SystemTask; {so you can support Desk Accessories}
-
- ProcessIt := GetNextEvent(EveryEvent,Event);
- If ProcessIt{is true} then {we'll ProcessIt}
- Case Event.what of
-
- mouseDown : DealwthMouseDowns(Event);
- KeyDown : DealwthKeyDowns (Event);
- ActivateEvt: DealwthActivates (Event);
- UpDateEvt : DealwthUpdates (Event);
-
- End;{of Case}
- Until Finished; {terminate the program}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE InitIcons;
- { Manually stuff some icons. Normally we would read them from a file }
- BEGIN
- {each line contains 48 HEX #s which fill 12 consecutive words up to 96}
-
- { Lisa }
- StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC');
- StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3');
- StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923');
- StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23');
- StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023');
- StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C');
- StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580');
- StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00');
-
- { Printer }
- StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000');
- StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440');
- StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000');
- StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003');
- StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37');
- StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356');
- StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160');
- StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000');
-
- { Trash Can }
- StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000');
- StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000');
- StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800');
- StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00');
- StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00');
- StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C');
- StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09');
- StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0');
-
- { tray }
- StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000');
- StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0');
- StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8');
- StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58');
- StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58');
- StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58');
- StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0');
- StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00');
-
- { File Cabinet }
- StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400');
- StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400');
- StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
- StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400');
- StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400');
- StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
- StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800');
- StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000');
-
- { drawer }
- StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000');
- StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000');
- StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000');
- StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0');
- StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0');
- StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0');
- StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00');
- StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000');
-
- END;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE PutPicScrap;
- Var err: LongInt;
- PicRect: Rect;
- PicHdl: PicHandle;
- PicLen: LongInt;
- Begin
- PicRect := DefaltPage;
- PicRect.bottom := PicRect.bottom Div 2;
- PicRect.right := PicRect.right Div 2;
-
- BuildQDPicture(theScreen);
-
- PicHdl := OpenPicture(PicRect);
- DrawPicture(QDPicture, PicRect);
- ClosePicture;
- PicLen := PicHdl^^.PicSize;
-
- HLock(Handle(PicHdl));
- err := ZeroScrap;
- err := PutScrap(PicLen, 'PICT', Pointer(PicHdl^));
- HUnLock(Handle(PicHdl));
- KillPicture(QDPicture);
- KillPicture(PicHdl);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE InitThings;
- Begin
- InitGraf(@thePort); {create a grafport for the screen}
-
- MoreMasters; {extra pointer blocks at the bottom of the heap}
- MoreMasters; {this is 5 X 64 master pointers}
- MoreMasters;
- MoreMasters;
- MoreMasters;
-
- {get the cursors we use and lock them down - no clutter}
- ClockCursor := GetCursor(watchCursor);
- HLock(Handle(ClockCursor));
-
- {show the watch while we wait for inits & setups to finish}
- SetCursor(ClockCursor^^);
-
- {init everything in case the app is the Startup App}
- InitFonts; {startup the fonts manager}
- InitWindows; {startup the window manager}
- InitMenus; {startup the menu manager}
- TEInit; {startup the text edit manager}
- InitDialogs(Nil); {startup the dialog manager}
-
- {set some global stuff}
- Finished := False; {set program terminator to false}
- FlushEvents(everyEvent,0); {clear events from previous program}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetupLimits;
- Begin
- Screen := ScreenBits.Bounds; {set the size of the screen}
- SetRect(DragArea,Screen.left+4,Screen.top+24,Screen.right-4,Screen.bottom-4);
- SetRect(GrowArea,Screen.left,Screen.top+24,Screen.right,Screen.bottom);
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetupMenus;
- Var MenuTopic: MenuHandle;
- NameHolder: STR255;
- FoundIt: Boolean;
- Item_No: Integer;
- NumItems: Integer;
- FontID: Integer;
- useThisFont: Integer;
-
- Begin
- MenuTopic := GetMenu(AppleMenu); {get the apple desk accessories menu}
- AddResMenu(MenuTopic,'DRVR'); {adds all names into item list}
- InsertMenu(MenuTopic,0); {put in list held by menu manager}
-
- MenuTopic := GetMenu(PrDlogMenu);
- InsertMenu(MenuTopic,0);
-
- MenuTopic := GetMenu(PrintMenu);
- InsertMenu(MenuTopic,0);
-
- MenuTopic := GetMenu(PrDrvrMenu);
- InsertMenu(MenuTopic,0);
-
- MenuTopic := GetMenu(FontMenu);
- AddResMenu(MenuTopic,'FONT');
- InsertMenu(MenuTopic,0);
-
- MenuTopic := GetMenu(StyleMenu);
- InsertMenu(MenuTopic,0);
-
- MenuTopic := GetMenu(PicScrMenu);
- InsertMenu(MenuTopic,0);
-
- {check off the default font. If LaserWriter set to Helvetica}
- If theLaserW = GetStuff(PrRecordHdl^^.PrStl.wDev).b1
- then useThisFont := 20 {helvetica}
- else useThisFont := Geneva;
-
- MenuTopic := GetMenu(FontMenu); {menu handle for fonts}
- NumItems := CountMItems(MenuTopic); {number of fonts in menu}
- FoundIt := False;
- Item_No := 1;
- Repeat
- GetItem(MenuTopic, Item_No, NameHolder); {get new font name}
- GetFNum(NameHolder, FontID); {get the font ID}
- If FontID = useThisFont then {is it same as default font??}
- begin
- PrevFontChked := Item_No; {save the new font No}
- CheckItem(MenuTopic, Item_No, True); {check it off in menu}
- FoundIt := true;
- end;
- Item_No := Item_No + 1;
- Until (Item_No > NumItems) or FoundIt;
-
- {check off the font style}
- MenuTopic := GetMenu(StyleMenu); {menu handle for style}
- CheckItem(MenuTopic, 1, True); {check the plain style}
-
- {check off the size}
- CheckItem(MenuTopic, 10, True); {check the 12 point}
-
- {set the global guys}
- CurntFontID := FontID; {the default font}
- CurntStyleID := []; {plain}
- CurntSizeID := 12; {size 12}
-
- {because we didn't finish the code.... disable some menu items}
- MenuTopic := GetMHandle(PrDrvrMenu);
- DisableItem(MenuTopic, 5); {write postscript sample}
-
- MenuTopic := GetMHandle(PrintMenu);
- DisableItem(MenuTopic, 11); {trick polygon}
-
- {now draw the menu bar}
- DrawMenuBar; {all done so show the menu bar}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetupAWindow;
- Begin
- aWindow := GetNewWindow(WindResID, Nil, Pointer(-1));
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetupPrPort;
- Var dummy: boolean;
- Begin
- PrRecordHdl := THPrint(NewHandle(SizeOf(TPrint))); {Make space for the record}
- PrOpen; {open up ptr resource file}
- PrintDefault(PrRecordHdl); {fill rec w/default params}
- DefaltPage := PrRecordHdl^^.prInfoPT.rPage; {default printer page size}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SetUpThings;
- Begin
- SetupLimits;
- SetupAWindow;
- SetupPrPort;
- SetupMenus; {this order is important for checking items off}
-
- InitCursor; {ready to go, so show the Arrow cursor}
- End;
-
- {-----------------------------------------------------------------------------}
-
- PROCEDURE CloseThings;
- Var PrChooser: LMwordPtr;
- Begin
- {make sure the Chooser is enabled upon leaving the App}
- PrChooser := LMwordPtr($946); {set the address}
- GetStuff(PrChooser^).f15 := TRUE; {set bit7 of $946}
- PrClose;
- End;
-
- {-----------------------------------------------------------------------------}
-
- BEGIN
- InitThings;
- SetUpThings;
- MainEventLoop;
- CloseThings;
- END.
-